home *** CD-ROM | disk | FTP | other *** search
/ Gamers Delight 2 / Gamers Delight 2.iso / Aminet / game / misc / Tiles.lha / Tiles / TilesPlay.mod < prev    next >
Text File  |  1989-08-27  |  28KB  |  900 lines
  1. (*$T- Range checking off *)
  2. (*$S- Stack checking off *)
  3. IMPLEMENTATION MODULE TilesPlay;
  4.  
  5. (* Game stolen from the Mac by Todd Lewis.
  6.    Lots of code ideas from Trails, by Richard Bielak.
  7.    Created: 3/15/88 by Todd Lewis
  8.    Modified:
  9. Copyright (c) 1988 by Todd Lewis
  10. This program can be freely copied, but please
  11. leave my name in. Thanks, Todd.
  12. *)
  13.  
  14. FROM SYSTEM IMPORT TSIZE,ADR, BYTE, WORD, ADDRESS, SETREG, NULL,CODE;
  15. FROM Intuition IMPORT Image, Border, DrawImage, DrawBorder,RememberPtr,
  16.         AllocRemember,FreeRemember,Remember,IntuitionBase,CurrentTime;
  17. FROM Memory IMPORT MemReqSet,MemChip;
  18. FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, Jam2, Jam1,
  19.      Complement, DrawingModeSet, BitMapPtr, BitMap, InitBitMap;
  20. FROM Blitter IMPORT BltBitMapRastPort,BltMaskBitMapRastPort;
  21. FROM BlitterHardware IMPORT BplCon0;
  22. FROM Pens IMPORT Flood, Draw, Move, SetAPen, SetDrMd, RectFill;
  23. FROM PenUtils IMPORT SetWrMsk,SetOPen,BoundaryOff;
  24. FROM Rasters IMPORT TmpRas,InitTmpRas,SetRast,
  25.      RastPortPtr,RastPort,AllocRaster,FreeRaster,InitRastPort;
  26. FROM Screens IMPORT DisplayBeep;
  27. FROM RandomNumbers IMPORT Random, Seed;
  28. FROM Windows IMPORT SetWindowTitles;
  29. FROM InputEvents IMPORT LButton, UpPrefix;
  30. FROM Areas IMPORT AreaDraw,AreaMove,AreaEnd,InitArea,AreaInfo;
  31. FROM InOut IMPORT WriteString, WriteLn,WriteCard;
  32. (* The modules below are home grown *)
  33. FROM TilesIcons IMPORT IconsAddr;
  34. FROM TilesScreen IMPORT wp,sp;
  35.  
  36. CONST IconTypes = 36;
  37.       LastIcon  = IconTypes - 1;
  38.       maxx = 31; maxy = 17;  ysize = 20-1; xsize = 40-1;
  39.       (* pen numbers/border colors *)
  40.       bcSelected = 12; bcHigh = 13; bcLevel = 14; bcLow = 15;
  41.       rassize = 20 * ((20+15) DIV 8);
  42. TYPE
  43.   TType = (Empty,TopLeft,TopRight,LowLeft,LowRight);
  44.   TileType = RECORD
  45.            Icon,
  46.            ord   : CARDINAL;
  47.            top   : INTEGER;
  48.            tType : TType;
  49.            Played: BOOLEAN;
  50.            Nominated : BOOLEAN;
  51.            END;
  52.   MemRec = RECORD
  53.             x0,y0,z0,
  54.             x1,y1,z1 : CARDINAL;
  55.             END;
  56.   MyBitMapType = RECORD
  57.                 bm :ARRAY[0..LastIcon],[0..1],[0..ysize],[0..2] OF WORD;
  58.                 END;
  59.   MyBitMapPtr = POINTER TO MyBitMapType;
  60. VAR
  61.   WorkingTitle,PlayTitle,noTitle : ARRAY[0..50] OF CHAR;
  62.   Noms   : CARDINAL;
  63.   rp     : RastPortPtr;
  64.   Tile   : ARRAY[0..maxx],[0..maxy],[0..4] OF TileType;
  65.   MyBitMap : MyBitMapPtr;
  66.   MyBitMap1: MyBitMapPtr;
  67.   TmpBM  : BitMap;
  68.   TmpRP  : RastPort;
  69.   Icons  : ARRAY[0..LastIcon] OF RECORD
  70.               count : CARDINAL;
  71.               image : Image;
  72.               END;
  73.   border1 : Border;
  74.   borderarray : ARRAY[0..15],[0..1] OF INTEGER;
  75.   border2 : Border;
  76.   border2rray : ARRAY[0..15],[0..1] OF INTEGER;
  77.   RememberKey : RememberPtr;
  78.   CurTile : RECORD
  79.                Selected : BOOLEAN;
  80.                x,y,z    : CARDINAL;
  81.                Icon     : CARDINAL;
  82.                END;
  83.   areabuf   : ARRAY[0..250] OF WORD;
  84.   areainfo  : AreaInfo;
  85.   tmpras,tmpras2    : TmpRas;
  86.   tmprasbufptr,tmprbuf2 : ADDRESS; (* points to temporary raster work bitmap *)
  87.   UndoRec : RECORD
  88.                i : CARDINAL;
  89.                LastM : ARRAY[0..122] OF MemRec;
  90.                END;
  91.  
  92. PROCEDURE FreeBitMap;
  93.   VAR bool : BOOLEAN;
  94.   BEGIN
  95.     FreeRemember(RememberKey,TRUE);
  96.     FreeRaster(TmpBM.Planes[0],300,200);
  97.     FreeRaster(TmpBM.Planes[1],300,200);
  98.     FreeRaster(TmpBM.Planes[2],300,200);
  99.     FreeRaster(TmpBM.Planes[3],300,200);
  100.     END FreeBitMap;
  101.  
  102. PROCEDURE SeedRandomNumGen;
  103.   VAR Seconds,Micros : LONGCARD;
  104.   BEGIN
  105.     CurrentTime(ADR(Seconds),ADR(Micros));
  106.     Seed(Micros);
  107.     END SeedRandomNumGen;
  108.  
  109. PROCEDURE InitTiles;
  110.   VAR i,x,y,z : CARDINAL;
  111.  
  112.   PROCEDURE q(x1,x2, y1,y2, z:CARDINAL);
  113.     VAR x,y : CARDINAL;
  114.     BEGIN
  115.       FOR x := x1 TO x2 BY 2 DO
  116.         FOR y := y1 TO y2 BY 2 DO
  117.           Tile[x  ][y  ][z].tType := TopLeft;
  118.           Tile[x+1][y  ][z].tType := TopRight;
  119.           Tile[x  ][y+1][z].tType := LowLeft;
  120.           Tile[x+1][y+1][z].tType := LowRight;
  121.           END;
  122.         END;
  123.       END q;
  124.  
  125.   BEGIN
  126.     SetWindowTitles(wp, noTitle, WorkingTitle);
  127.     rp := wp^.RPort;
  128.     SeedRandomNumGen;
  129.     CurTile.Selected := FALSE;
  130.     UndoRec.i := 0;
  131.  
  132.     borderarray[0,0] := -1;borderarray[0,1] :=21;
  133.     borderarray[1,0] := -1;borderarray[1,1] := 0;
  134.     borderarray[2,0] := -6;borderarray[2,1] :=-3;
  135.     borderarray[3,0] := -6;borderarray[3,1] :=19;
  136.     borderarray[4,0] := -6;borderarray[4,1] :=-3;
  137.     borderarray[5,0] := 35;borderarray[5,1] :=-3;
  138.     borderarray[6,0] := 41;borderarray[6,1] := 0;
  139.     borderarray[7,0] := 41;borderarray[7,1] :=21;
  140.     borderarray[8,0] := -1;borderarray[8,1] :=21;
  141.     borderarray[9,0] := -5;borderarray[9,1] :=19;
  142.     borderarray[10,0]:=  0;borderarray[10,1] :=21;
  143.     borderarray[11,0]:=  0;borderarray[11,1] := 0;
  144.     borderarray[12,0]:= 40;borderarray[12,1]:= 0;
  145.     borderarray[13,0]:= 40;borderarray[13,1]:=21;
  146.     border1.NextBorder := NULL;        border1.LeftEdge := 0;
  147.     border1.XY := ADR(borderarray);    border1.TopEdge  := 0;
  148.     border1.FrontPen := BYTE(13);      border1.Count    := BYTE(14);
  149.     border1.BackPen  := BYTE(3);
  150.     border1.DrawMode := BYTE(Jam1);
  151.  
  152.     border2rray[0, 0] := 39; border2rray[0, 1] :=-1;
  153.     border2rray[1, 0] := -1; border2rray[1, 1] :=-1;
  154.     border2rray[2, 0] := -1; border2rray[2, 1] :=20;
  155.     border2rray[3, 0] := -2; border2rray[3, 1] :=20;
  156.     border2rray[4, 0] := -2; border2rray[4, 1] :=-1;
  157.     border2rray[5, 0] := -3; border2rray[5, 1] :=-1;
  158.     border2rray[6, 0] := -3; border2rray[6, 1] :=19;
  159.     border2rray[7, 0] := -4; border2rray[7, 1] :=19;
  160.     border2rray[8, 0] := -4; border2rray[8, 1] :=-3;
  161.     border2rray[9, 0] := -5; border2rray[9, 1] :=-3;
  162.     border2rray[10,0] := -5; border2rray[10,1] :=18;
  163.     border2rray[11,0] := -5; border2rray[11,1] :=-3;
  164.     border2rray[12,0] := 35; border2rray[12,1] :=-3;
  165.     border2rray[13,0] := -4; border2rray[13,1] :=-2;
  166.     border2rray[14,0] := 37; border2rray[14,1] :=-2;
  167.     border2.NextBorder := ADR(border1);     border2.LeftEdge := 0;
  168.     border2.XY := ADR(border2rray); border2.TopEdge  := 0;
  169.     border2.FrontPen := BYTE(14);   border2.Count    := BYTE(15);
  170.     border2.BackPen  := BYTE(3);
  171.     border2.DrawMode := BYTE(Jam1);
  172.  
  173.     IF RememberKey = NULL
  174.        THEN MyBitMap1 := IconsAddr();
  175.             MyBitMap := AllocRemember(RememberKey,TSIZE(MyBitMapType),MemReqSet{MemChip});
  176.             IF MyBitMap # NULL
  177.                THEN MyBitMap^.bm := MyBitMap1^.bm;
  178.                END;
  179.  
  180.             InitBitMap(TmpBM,4,300,200);
  181.             TmpBM.Planes[0] := AllocRaster(300,200);
  182.             TmpBM.Planes[1] := AllocRaster(300,200);
  183.             TmpBM.Planes[2] := AllocRaster(300,200);
  184.             TmpBM.Planes[3] := AllocRaster(300,200);
  185.  
  186.             InitRastPort(ADR(TmpRP));
  187.             TmpRP.bitMap := ADR(TmpBM);
  188.             TmpRP.tmpRas := ADR(tmpras);
  189.             rp^.tmpRas   := ADR(tmpras2);
  190.             tmprasbufptr := AllocRemember(RememberKey,
  191.                               rassize,
  192.                               MemReqSet{MemChip});
  193.             tmprbuf2     := AllocRemember(RememberKey,
  194.                               rassize,
  195.                               MemReqSet{MemChip});
  196.  
  197.  
  198.             InitArea(areainfo,areabuf,100);
  199.             InitTmpRas(ADR(tmpras),tmprasbufptr,rassize);
  200.             InitTmpRas(ADR(tmpras2),tmprbuf2,rassize);
  201.        END;
  202.  
  203.     SetRast(rp,0);
  204.     FOR x := 0 TO maxx DO
  205.       FOR y := 0 TO maxy DO
  206.         FOR z := 0 TO 4 DO
  207.           WITH Tile[x,y,z] DO
  208.             tType := Empty; Played := TRUE;
  209.             Icon := 0; ord := 0; Nominated := FALSE;
  210.             top := -1;
  211.             END;
  212.           END;
  213.         END;
  214.       END;
  215.  
  216.     FOR x := 0 TO LastIcon DO
  217.       WITH Icons[x] DO
  218.         count := 0;
  219.         WITH image DO
  220.           ImageData := ADR(MyBitMap^.bm[x]);  LeftEdge := 1;
  221.           PlanePick := BYTE(3);         TopEdge  := 1;
  222.           PlaneOnOff:= BYTE(0);  Width := 40; Height := 20; Depth := 2;
  223.           NextImage := NULL;
  224.           END;
  225.         END;
  226.       END;
  227.  
  228.     (*x1,x2,y1,y2, z *)
  229.     (* Bottom Layer *)   (* Second Layer *)
  230.     q( 3,25, 1, 1, 0);   q( 9,19, 3,13, 1);
  231.     q( 7,21, 3,13, 0);
  232.     q( 3,25,15,15, 0);   (* Third Layer  *)
  233.     q( 5,23, 5,11, 0);   q(11,17, 5,11, 2);
  234.     q( 3,25, 7, 9, 0);   (* Fourth Layer *)
  235.     q( 1, 1, 8, 8, 0);   q(13,15, 7, 9, 3);
  236.     q(27,29, 8, 8, 0);   q(14,14, 8, 8, 4);
  237.  
  238.     PlaceTiles;
  239.  
  240.     border1.FrontPen := BYTE(15);
  241.     border2.FrontPen := BYTE(14);
  242.     FOR z := 0 TO 4 DO
  243.       FOR x := maxx TO 1 BY -1 DO
  244.         FOR y := maxy TO 1 BY -1 DO
  245.           IF Tile[x,y,z].tType = TopLeft
  246.              THEN (* Show(x,y,z,FALSE);*) (* x,y,z are Normalized *)
  247.                   IF Visible(x,y,z)
  248.                      THEN DrawImage(rp,Icons[Tile[x,y,z].Icon].image,
  249.                             px(x) + 5 + 6*z,
  250.                             py(y) + 2 + 3*z);
  251.                           DoShadows(rp,x,y,z,px(x)+5+6*z,py(y)+2+3*z);
  252.                      END;
  253.                   DrawBorder(rp,border2,px(x)+5+6*z,py(y)+2+3*z);
  254.              END;
  255.           END;
  256.         END;
  257.       END;
  258.     SetWindowTitles(wp, noTitle, PlayTitle);
  259.     END InitTiles;
  260.  
  261. PROCEDURE PlaceTiles;
  262.   VAR x,y,z,i, cnt : CARDINAL;
  263.       TilesPlaced : CARDINAL;
  264.       UnPlaceGroupSize : CARDINAL;
  265.   PROCEDURE PlaceTilesSetUp;
  266.     VAR y : CARDINAL;
  267.     BEGIN
  268.       SetRast(rp,6);
  269.       TilesPlaced := 0;
  270.       UnPlaceGroupSize := 8; (* Seems like a good number? *)
  271.       ClearNoms();
  272.       UndoRec.i := 0;
  273.       z := 0; (* work on bottom level *)
  274.       FOR y := 1 TO 15 BY 2 DO  (* get each row *)
  275.         x := 9 + Random(5) * 2; (* should be a TopLeft tile *)
  276.         Normalize(x,y,z);  (* but don't take chances *)
  277.         SetNominated(x,y,z, TRUE);
  278.         END;
  279.       Noms := NomCount();
  280.       (* Now we should have 8 Tiles nominated for board use. *)
  281.       SetRast(rp,0);
  282.       END PlaceTilesSetUp;
  283.   BEGIN
  284.     PlaceTilesSetUp;
  285.     WHILE (TilesPlaced < (IconTypes * 4)) DO
  286.       IF (Noms > 1)
  287.          THEN Place2Tiles();
  288.               TilesPlaced := TilesPlaced + 2;
  289.          ELSE UnPlaceGroupSize := UnPlaceGroupSize + 2;
  290.               IF (UnPlaceGroupSize >= TilesPlaced)
  291.                  THEN PlaceTilesSetUp;
  292.                  ELSE FOR i := 0 TO UnPlaceGroupSize BY 2 DO
  293.                           UnPlace2Tiles;
  294.                           TilesPlaced := TilesPlaced - 2;
  295.                           END; (* FOR *)
  296.                  END; (* IF *)
  297.          END;
  298.       END; (* WHILE *)
  299.     UndoRec.i := 0;
  300.     END PlaceTiles;
  301.  
  302. PROCEDURE SetPlayed(x,y,z:CARDINAL; played:BOOLEAN);
  303.   BEGIN
  304.     Tile[x,y  ,z].Played := played;  Tile[x+1,y  ,z].Played := played;
  305.     Tile[x,y+1,z].Played := played;  Tile[x+1,y+1,z].Played := played;
  306.     IF NOT played
  307.        THEN SetNominated(x,y,z,FALSE);
  308.        END;
  309.     Tile[x,y  ,0].top:=ColTop(x,y);  Tile[x+1,y  ,0].top:=ColTop(x+1,y);
  310.     Tile[x,y+1,0].top:=ColTop(x,y+1);Tile[x+1,y+1,0].top:=ColTop(x+1,y+1);
  311.     END SetPlayed;
  312.  
  313. PROCEDURE SetNominated(x,y,z:CARDINAL; n:BOOLEAN);
  314.   BEGIN
  315.     IF (Tile[x,y,z].Nominated = n) THEN RETURN; END;
  316.     Tile[x,y  ,z].Nominated := n;  Tile[x+1,y  ,z].Nominated := n;
  317.     Tile[x,y+1,z].Nominated := n;  Tile[x+1,y+1,z].Nominated := n;
  318.     IF n
  319.        THEN INC(Noms);
  320.        ELSE IF (Noms > 0)
  321.                THEN DEC(Noms);
  322.                END;
  323.        END;
  324.     END SetNominated;
  325.  
  326. PROCEDURE UnPlace2Tiles;
  327.   VAR a,b,c : CARDINAL;
  328.   BEGIN
  329.     WITH UndoRec.LastM[UndoRec.i] DO
  330.       DEC(Icons[Tile[x0,y0,z0].Icon].count);
  331.       DEC(Icons[Tile[x0,y0,z0].Icon].count);
  332.       WITH Tile[x0,y0,z0] DO
  333.         Icon := 0;
  334.         ord := 0;
  335.         END; (* WITH *)
  336.       SetPlayed(x0,y0,z0,TRUE);
  337.       SetNominated(x0,y0,z0,FALSE);
  338.       WITH Tile[x1,y1,z1] DO
  339.         Icon := 0;
  340.         ord := 0;
  341.         END; (* WITH *)
  342.       SetPlayed(x1,y1,z1,TRUE);
  343.       SetNominated(x1,y1,z1,FALSE);
  344.       END; (* WITH *)
  345.     DEC(UndoRec.i);
  346.     FOR a := 1 TO 31 DO
  347.       FOR b := 1 TO 15 DO
  348.         FOR c := 0 TO 4 DO
  349.           IF (Tile[a,b,c].tType = TopLeft)
  350.              THEN SetNominated(a,b,c,FALSE);
  351.              END;
  352.           END;
  353.         END;
  354.       END;
  355.     FOR a := 1 TO 31 DO
  356.       FOR b := 1 TO 15 DO
  357.         FOR c := 0 TO 4 DO
  358.           IF (Tile[a,b,c].tType = TopLeft)
  359.              THEN NomTest(a,b,c); (* a,b,and c are Normalized *)
  360.              END;
  361.           END;
  362.         END;
  363.       END;
  364.     END UnPlace2Tiles;
  365.  
  366. PROCEDURE NomTest( a,b,c: CARDINAL);  (* a,b,c should be Normalized *)
  367.   VAR d,e,f, i,j,k : CARDINAL;
  368.      ci : INTEGER;
  369.      Ok1,Ok2 : BOOLEAN;
  370.   BEGIN
  371.     IF (Tile[a,b,c].tType # TopLeft) THEN RETURN; END;
  372.     IF (Tile[a,b,c].Played = FALSE) THEN RETURN; END;
  373.  
  374.     ci := INTEGER( c - 1 );
  375.     IF (ColTop(a,b  ) # ci) OR (ColTop(a+1,b  ) # ci) OR
  376.        (ColTop(a,b+1) # ci) OR (ColTop(a+1,b+1) # ci)
  377.        THEN RETURN; END;
  378.  
  379.     IF (Tile[a-1,b  ,c].Played = FALSE) AND
  380.        (Tile[a-1,b+1,c].Played = FALSE)
  381.        THEN SetNominated(a,b,c,TRUE);
  382.             RETURN;
  383.        END;
  384.  
  385.     IF (Tile[a+2,b  ,c].Played = FALSE) AND
  386.        (Tile[a+2,b+1,c].Played = FALSE)
  387.        THEN SetNominated(a,b,c,TRUE);
  388.             RETURN;
  389.        END;
  390.  
  391.     (* if there are no other pieces placed or nominated
  392.        on my row, then I can accept the nomination *)
  393.     d := 1; e := b + 1;
  394.     LOOP
  395.       IF (Tile[d, b, c].Played = FALSE) THEN RETURN; END;
  396.       IF (Tile[d, e, c].Played = FALSE) THEN RETURN; END;
  397.       IF (Tile[d, b, c].Nominated) THEN RETURN; END;
  398.       IF (Tile[d, e, c].Nominated) THEN RETURN; END;
  399.       INC(d);
  400.       IF (d > 30) THEN EXIT; END;
  401.       END; (* LOOP *)
  402.     SetNominated(a,b,c,TRUE);
  403.     END NomTest;
  404.  
  405. PROCEDURE Place2Tiles();
  406.   VAR x,y,z,X1,Y1,Z1,X2,Y2,Z2,a,b,c,d : CARDINAL;
  407.   BEGIN
  408.     REPEAT
  409.       a := Random(Noms) + 1;   (* [1..Noms] *)
  410.       b := Random(Noms) + 1;
  411.       UNTIL (a # b) AND (a > 0) AND (a <=Noms) AND
  412.                         (b > 0) AND (b <=Noms);
  413.     REPEAT
  414.       c := Random(IconTypes);  (* [0..IconTypes-1] *)
  415.       UNTIL (Icons[c].count < 4);
  416.     d := 0;
  417.     x := 1;
  418.     WHILE (x <= 31) AND ((d < a) OR (d < b)) DO
  419.       y := 1;
  420.       WHILE (y <=15 ) AND ((d < a) OR (d < b)) DO
  421.         z := 0;
  422.         WHILE ((NOT Tile[x,y,z].Played) OR (Tile[x,y,z].Nominated)) AND
  423.               ( z < 5                                             ) DO
  424.           WITH Tile[x,y,z] DO
  425.             IF (tType = TopLeft) AND ( Nominated )
  426.                THEN d := d + 1;
  427.                     IF (d = a) OR (d = b)
  428.                        THEN SetNominated(x,y,z,FALSE);
  429.                             INC(Icons[c].count);
  430.                             Icon := c;
  431.                             SetPlayed(x,y,z,FALSE);
  432.                             ord := Icons[c].count;
  433.                             IF (d = a)
  434.                                THEN X1 := x; Y1 := y; Z1 := z;
  435.                                ELSE X2 := x; Y2 := y; Z2 := z;
  436.                                END;
  437.                             (* Show(x,y,z,TRUE); *)
  438.                        END; (* IF *)
  439.                END; (* IF *)
  440.             END; (* WITH *)
  441.           INC(z);
  442.           END; (* WHILE ... *)
  443.         INC(y);
  444.         END;  (* WHILE y ... *)
  445.       INC(x)
  446.       END;  (* WHILE x *)
  447.     INC(UndoRec.i);
  448.     WITH UndoRec.LastM[UndoRec.i] DO
  449.       x0 := X1; y0 := Y1; z0 := Z1;
  450.       x1 := X2; y1 := Y2; z1 := Z2;
  451.       END;
  452.     DoNomsAround(X1,Y1,Z1);
  453.     DoNomsAround(X2,Y2,Z2);
  454.     END Place2Tiles;
  455.  
  456. PROCEDURE DoNomsAround(x,y,z: CARDINAL);
  457.   BEGIN
  458.     IF (x > 1)
  459.        THEN Nominate(x-1,y  ,z);
  460.             Nominate(x-1,y+1,z);
  461.        END;
  462.     IF (z < 4)
  463.        THEN Nominate(x  ,y  ,z+1);
  464.             Nominate(x  ,y+1,z+1);
  465.             Nominate(x+1,y  ,z+1);
  466.             Nominate(x+1,y+1,z+1);
  467.        END;
  468.     IF (x < 29)
  469.        THEN Nominate(x+2,y  ,z);
  470.             Nominate(x+2,y+1,z);
  471.        END;
  472.     END DoNomsAround;
  473.  
  474. PROCEDURE Nominate(x,y,z:CARDINAL);
  475.   BEGIN
  476.     Normalize(x,y,z);
  477.     IF (Tile[x,y,z].tType # TopLeft) THEN RETURN; END;
  478.     NomTest(x,y,z); (* x,y, and z are Normalized *)
  479.     END Nominate;
  480.  
  481. PROCEDURE ClearNoms();
  482.   VAR x,y,z : CARDINAL;
  483.   BEGIN
  484.     FOR x := 0 TO LastIcon DO
  485.       WITH Icons[x] DO
  486.         count := 0;
  487.         WITH image DO
  488.           ImageData := ADR(MyBitMap^.bm[x]);  LeftEdge := 1;
  489.           PlanePick := BYTE(3);         TopEdge  := 1;
  490.           PlaneOnOff:= BYTE(0);  Width := 40; Height := 20; Depth := 2;
  491.           NextImage := NULL;
  492.           END;
  493.         END;
  494.       END;
  495.     FOR x := 1 TO maxx DO
  496.       FOR y := 1 TO maxy DO
  497.         FOR z := 0 TO 4 DO
  498.           WITH Tile[x,y,z] DO
  499.             top := -1;
  500.             IF tType = TopLeft
  501.                THEN SetNominated(x,y,z,FALSE);
  502.                     Icon := 0; ord := 0;
  503.                     SetPlayed(x,y,z,TRUE);
  504.                END;
  505.             END; (* WITH *)
  506.           END; (* FOR z *)
  507.         END; (* FOR y *)
  508.       END; (* FOR x *)
  509.     Noms := 0;
  510.     END ClearNoms;
  511.  
  512. PROCEDURE NomCount():CARDINAL;
  513.   VAR x,y,z,a : CARDINAL;
  514.   BEGIN
  515.     a := 0;
  516.     FOR x := 1 TO 31 DO
  517.       FOR y := 1 TO 15 DO
  518.         FOR z := 0 TO 4 DO
  519.           WITH Tile[x,y,z] DO
  520.             IF tType = TopLeft
  521.                THEN IF Nominated THEN INC(a); END;
  522.                END;
  523.             END; (* WITH *)
  524.           END; (* FOR z *)
  525.         END; (* FOR y *)
  526.       END; (* FOR x *)
  527.     Noms := a;
  528.     RETURN a;
  529.     END NomCount;
  530.  
  531. PROCEDURE Visible(x,y:CARDINAL; Z:WORD):BOOLEAN;
  532.   VAR z : INTEGER;
  533.   BEGIN
  534.     z := INTEGER(Z);
  535.     IF (ColTop(x,y  ) = z) OR (ColTop(x+1,y  ) = z) OR
  536.        (ColTop(x,y+1) = z) OR (ColTop(x+1,y+1) = z)
  537.        THEN RETURN TRUE;
  538.        ELSE RETURN FALSE;
  539.        END;
  540.     END Visible;
  541.  
  542. PROCEDURE UnDo;
  543.   BEGIN
  544.     IF UndoRec.i = 0 THEN RETURN; END;
  545.     DEC(UndoRec.i);
  546.     WITH UndoRec.LastM[UndoRec.i] DO
  547.       SetPlayed(x0,y0,z0,FALSE);
  548.       SetPlayed(x1,y1,z1,FALSE);
  549.       Show(x0, y0, z0, TRUE);  (* these coordinates are Normalized *)
  550.       Show(x1, y1, z1, TRUE);  (* and so are these                 *)
  551.       END;
  552.     END UnDo;
  553.  
  554. PROCEDURE RemoveTiles(x,y,z:CARDINAL);
  555.   VAR x1,y1 : CARDINAL;
  556.   PROCEDURE sh(x,y,z:CARDINAL; bool:BOOLEAN);
  557.     BEGIN
  558.       Show(x,y,z,bool);
  559.       IF (INTEGER(z) >= 0)
  560.          THEN IF Tile[x,y,z].tType # TopLeft
  561.                  THEN Show(x+1,y,z,bool);
  562.                       Show(x+1,y+1,z,bool);
  563.                       Show(x,y+1,z,bool);
  564.                  END;
  565.          END;
  566.       END sh;
  567.   BEGIN
  568.     WITH UndoRec.LastM[UndoRec.i] DO
  569.          x0 := x;
  570.          y0 := y;
  571.          z0 := z;
  572.          x1 := CurTile.x;
  573.          y1 := CurTile.y;
  574.          z1 := CurTile.z;
  575.          END;
  576.     INC(UndoRec.i);
  577.  
  578.     SetPlayed(CurTile.x,CurTile.y,CurTile.z, TRUE);
  579.     SetPlayed(        x,        y,        z, TRUE);
  580.     sh(        x,         y,         z - 1, TRUE);
  581.     sh(CurTile.x, CurTile.y, CurTile.z - 1, TRUE);
  582.     CurTile.Selected := FALSE;
  583.     END RemoveTiles;
  584.  
  585. PROCEDURE Select(x,y,z:CARDINAL);
  586.   BEGIN
  587.     IF CurTile.Selected
  588.        THEN IF (x = CurTile.x) AND (y = CurTile.y) AND (z = CurTile.z)
  589.                THEN DeSelect(CurTile.x,CurTile.y,CurTile.z);
  590.                     RETURN;
  591.                END;
  592.             (* If we get here, x,y,z is a different Tile. *)
  593.             IF CurTile.Icon = Tile[x,y,z].Icon
  594.                THEN RemoveTiles(x,y,z);
  595.                     RETURN;
  596.                END;
  597.             (* If we get here, we have selected a different Icon type,
  598.                so Deselect the current one and highlight the new one. *)
  599.             DeSelect(CurTile.x,CurTile.y,CurTile.z);
  600.        END;
  601.  
  602.     Icons[Tile[x,y,z].Icon].image.PlaneOnOff := BYTE(0);
  603.     CurTile.Selected := TRUE;
  604.     CurTile.x := x;  CurTile.y := y;  CurTile.z := z;
  605.     CurTile.Icon := Tile[x,y,z].Icon;
  606.     Show(x,y,z,TRUE);
  607.     END Select;
  608.  
  609. PROCEDURE DeSelect(x,y,z:CARDINAL);
  610.   BEGIN
  611.     IF CurTile.Selected
  612.        THEN CurTile.Selected := FALSE;
  613.             Show(x,y,z,TRUE);
  614.        END;
  615.     END DeSelect;
  616.  
  617. PROCEDURE Show(x,y:CARDINAL; Z:WORD; doShadow :BOOLEAN);
  618.   VAR cx,cy,z,x1,y1,z1,level,sx,sy,shx,shy,xxx,yyy : CARDINAL;
  619.       tx,ty,dl,
  620.       j,col,row : INTEGER;
  621.   BEGIN
  622.     IF (x < 1) OR (x > 30) OR (y < 1) OR (y > 16) THEN RETURN; END;
  623.     j := INTEGER(Z);
  624.     z := CARDINAL(Z);
  625.     TmpRP.Mask := BYTE(15);
  626.     SetRast(ADR(TmpRP),0);  (* Clear Temp Rast Port *)
  627.     border1.FrontPen := BYTE(15);
  628.     border2.FrontPen := BYTE(14);
  629.     DrawBorder( ADR(TmpRP), border2, 6, 3);
  630.     border1.FrontPen := BYTE(12);
  631.     border2.FrontPen := BYTE(13);
  632.     DrawBorder( ADR(TmpRP), border2,54, 3);
  633.     FOR level := 0 TO 4 DO
  634.       FOR col := Min(2,30-x) TO Max(-3,-INTEGER(x)) BY -1 DO
  635.         FOR row := Min(2,16-y) TO Max(-3,-INTEGER(y)) BY -1 DO
  636.           tx := INTEGER(x) + col;  cx := CARDINAL(tx);
  637.           ty := INTEGER(y) + row;  cy := CARDINAL(ty);
  638.           IF (Tile[tx,ty,level].tType = TopLeft) AND
  639.              (Tile[tx,ty,level].Played = FALSE)
  640.              THEN sy := 0;
  641.                   sx := 0;
  642.                   Icons[Tile[tx,ty,level].Icon].image.PlaneOnOff := BYTE(0);
  643.                   IF (CurTile.Selected ) AND (CurTile.x = CARDINAL(tx)) AND
  644.                      (CurTile.y = CARDINAL(ty)) AND (CurTile.z = level)
  645.                      THEN Icons[Tile[tx,ty,level].Icon].image.PlaneOnOff := BYTE(4);
  646.                           sx := 48;
  647.                      END;
  648.                   TmpRP.Mask := BYTE(15);
  649.                   IF (Visible(tx,ty,level))
  650.                      THEN DrawImage(ADR(TmpRP),
  651.                             Icons[Tile[tx,ty,level].Icon].image,
  652.                             150+21*col+INTEGER(level)*6,
  653.                             100+11*row+INTEGER(level)*3);
  654.                           DoShadows(ADR(TmpRP),cx,cy,level,
  655.                             150+21*CARDINAL(col)+level*6,
  656.                             100+11*CARDINAL(row)+level*3);
  657.                      END;
  658.                   BltMaskBitMapRastPort(TmpRP.bitMap^,sx,sy,ADR(TmpRP),
  659.                             150+21*CARDINAL(col)+level*6-6,
  660.                             100+11*CARDINAL(row)+level*3-3,
  661.                             48,25,0E0H,(* ABC+ABNC+ANBC *)TmpRP.bitMap^.Planes[3]);
  662.              END;
  663.           END;
  664.         END;
  665.       END;
  666.     rp^.Mask := BYTE(15);
  667.     BltBitMapRastPort(TmpBM,144,97,
  668.                       rp,px(x)-1,py(y)-1,
  669.                       Min(73,639-px(x)),Min(41,199-py(y)),12*16);
  670.     END Show;
  671.  
  672. PROCEDURE DoShadows(dRP:RastPortPtr; x,y,z, x0, y0 : CARDINAL);
  673.     VAR xxx, yyy, shx, shy : CARDINAL;
  674.         dl : INTEGER;
  675.     BEGIN
  676.       dRP^.Mask := BYTE(8);
  677.       SetAPen( dRP, 8);
  678.       FOR shx := 0 TO  1 DO
  679.           FOR shy := 0 TO 1 DO
  680.               xxx := x0 + 21*shx;
  681.               yyy := y0 + 11*shy;
  682.  
  683.               dl  := ColTop(x+shx-1,y+shy) - ColTop(x+shx,y+shy);
  684.               IF (dl > 0)
  685.                  THEN Shadow( dRP,xxx,yyy,
  686.                       xxx+CARDINAL(Min(8*dl+2,20)),yyy+CARDINAL(Min(4*dl,10)),
  687.                       xxx+CARDINAL(Min(8*dl+2,20)),yyy+10,
  688.                       xxx,yyy+10);
  689.                  END;
  690.  
  691.               dl := ColTop(x+shx-1,y+shy-1) - ColTop(x+shx,y+shy);
  692.               IF (dl > 0)
  693.                  THEN Shadow(dRP,xxx,yyy,
  694.                       xxx+CARDINAL(Min(8*dl+2,20)),yyy,
  695.                       xxx+CARDINAL(Min(8*dl+2,20)),yyy+CARDINAL(Min(4*dl,10)),
  696.                       xxx,yyy+CARDINAL(Min(4*dl,10)));
  697.                  END;
  698.  
  699.               dl := ColTop(x+shx,y+shy-1) - ColTop(x+shx,y+shy);
  700.               IF (dl > 0)
  701.                  THEN Shadow(dRP,xxx,yyy,
  702.                       xxx+20,yyy,
  703.                       xxx+20,yyy+CARDINAL(Min(4*dl,10)),
  704.                       xxx+CARDINAL(Min(8*dl-2,20)),yyy+CARDINAL(Min(4*dl,10)));
  705.                  END;
  706.               END;
  707.           END;
  708.       dRP^.Mask := BYTE(15);
  709.       SetAPen( dRP, 15);
  710.       END DoShadows;
  711.  
  712. PROCEDURE Shadow(RPs: RastPortPtr; x0,y0, x1,y1, x2,y2, x3,y3:CARDINAL);
  713.   VAR
  714.       i   : INTEGER;
  715.   BEGIN
  716.     SetDrMd( RPs, Jam1);
  717.     SetAPen( RPs, 8 );
  718.     RPs^.Mask := BYTE(8);
  719.     BoundaryOff( RPs );
  720.     RPs^.areaInfo := ADR(areainfo);
  721.     i := AreaMove(RPs,x0,y0);
  722.     i := AreaDraw(RPs,x1,y1);
  723.     i := AreaDraw(RPs,x2,y2);
  724.     i := AreaDraw(RPs,x3,y3);
  725.     AreaEnd( RPs );
  726.     END Shadow;
  727.  
  728. (***************
  729. PROCEDURE DrawLine(color,x1,y1,x2,y2:CARDINAL);
  730.   BEGIN
  731.     SetAPen(rp, color);
  732.     SetDrMd(rp, Jam1);
  733.     Move   (rp, x1, y1);
  734.     Draw   (rp, x2, y2);
  735.     END DrawLine;
  736. **************)
  737.  
  738. PROCEDURE ColTop(x,y:CARDINAL):INTEGER;
  739.   VAR t,i : INTEGER;
  740.   BEGIN
  741.     t := -1;
  742.     IF (INTEGER(x) >= 0) AND (INTEGER(x) <=31) AND
  743.        (INTEGER(y) >= 0) AND (INTEGER(y) <=17)
  744.        THEN FOR i := 0 TO 4 DO
  745.               IF (Tile[x,y,i].Played = FALSE) THEN t := i; END;
  746.               END;
  747.             Tile[x,y,0].top := t;
  748.        END;
  749.     RETURN t;
  750.     END ColTop;
  751.  
  752. PROCEDURE Playable(x,y,z:CARDINAL):BOOLEAN;
  753.   VAR zi : INTEGER;
  754.   BEGIN
  755.     zi := INTEGER(z);
  756.     IF ( x < 1) OR (x > 30) OR
  757.        ( y < 1) OR (y > 16) OR
  758.        (zi < 0) OR (z > 4)  THEN RETURN FALSE; END;
  759.     IF (*Tile[x,  y  ,0].top*)
  760.        ColTop(x  ,y  ) > zi THEN RETURN FALSE; END;
  761.     IF (*Tile[x+1,y  ,0].top*)
  762.        ColTop(x+1,y  ) > zi THEN RETURN FALSE; END;
  763.     IF (*Tile[x+1,y+1,0].top*)
  764.        ColTop(x+1,y+1) > zi THEN RETURN FALSE; END;
  765.     IF (*Tile[x  ,y+1,0].top*)
  766.        ColTop(x  ,y+1) > zi THEN RETURN FALSE; END;
  767.  
  768.     IF ( ColTop(x-1,y  ) < zi) AND
  769.        ( ColTop(x-1,y+1) < zi)
  770.        THEN RETURN TRUE;
  771.        END;
  772.     IF ( ColTop(x+2,y  )  < zi) AND
  773.        ( ColTop(x+2,y+1)  < zi)
  774.        THEN RETURN TRUE;
  775.        END;
  776.     RETURN FALSE;
  777.     END Playable;
  778.  
  779. PROCEDURE Normalize(VAR x,y,z : CARDINAL);
  780.   BEGIN
  781.     IF (z < 5)
  782.        THEN CASE Tile[x,y,z].tType OF
  783.                 Empty    :
  784.              |  TopLeft  :
  785.              |  TopRight : x := x - 1;
  786.              |  LowLeft  : y := y - 1;
  787.              |  LowRight : y := y - 1; x := x - 1;
  788.              ELSE
  789.              END;
  790.        END;
  791.     END Normalize;
  792.  
  793. PROCEDURE UserInput(x,y:CARDINAL);
  794.   VAR z : CARDINAL; zi : INTEGER;
  795.       tx, ty: INTEGER;
  796.   PROCEDURE DESELECT;
  797.      BEGIN
  798.        DeSelect(CurTile.x,CurTile.y,CurTile.z);
  799.        END DESELECT;
  800.   PROCEDURE LevelShift(dx,dy,level:INTEGER):BOOLEAN;
  801.      BEGIN
  802.        tx := INTEGER(x) - dx;  ty := INTEGER(y) - dy;
  803.        IF (tx < 0) OR (ty < 0) THEN RETURN FALSE; END;
  804.        tx := (tx+15) DIV 21;
  805.        IF ty > 4
  806.           THEN ty := (ty-4) DIV 11;
  807.           ELSE ty := 0;
  808.           END;
  809.        IF (ColTop(tx,ty) = level) OR (level = 0)
  810.           THEN x := CARDINAL(tx);
  811.                y := CARDINAL(ty);
  812.                RETURN TRUE;
  813.           ELSE RETURN FALSE;
  814.           END;
  815.        END LevelShift;
  816.   BEGIN
  817.     IF NOT LevelShift(24,12,4)
  818.        THEN IF NOT LevelShift(18,9,3)
  819.                THEN IF NOT LevelShift(12,6,2)
  820.                        THEN IF NOT LevelShift(6,3,1)
  821.                                THEN IF LevelShift(0,0,0) THEN END;
  822.                                END;
  823.                        END;
  824.                END;
  825.        END;
  826.     zi := ColTop(x,y);
  827.     IF zi >= 0
  828.        THEN z := CARDINAL(zi);
  829.             Normalize(x,y,z);
  830.             (* Send x, y, and z off to be processed *)
  831.             (* then return to the caller *)
  832.             IF Playable(x,y,z)
  833.                THEN Select(x,y,z);
  834.                ELSE DESELECT;
  835.                END;
  836.        ELSE IF CurTile.Selected
  837.                THEN DESELECT;
  838.                ELSE UnDo;
  839.                END;
  840.        END;
  841.     END UserInput;
  842.  
  843. PROCEDURE px(x:CARDINAL):CARDINAL;
  844.   BEGIN
  845.     IF INTEGER(x) > 0
  846.        THEN RETURN 21*x-20;
  847.        ELSE RETURN 0;
  848.        END;
  849.     END px;
  850.  
  851. PROCEDURE py(y:CARDINAL):CARDINAL;
  852.   BEGIN
  853.     IF INTEGER(y) > 0
  854.        THEN RETURN 2+11*y;
  855.        ELSE RETURN 0;
  856.        END;
  857.     END py;
  858.  
  859. PROCEDURE dx(x:CARDINAL):CARDINAL;
  860.   BEGIN
  861.     IF INTEGER(x) > 0
  862.        THEN RETURN x * 4;
  863.        ELSE RETURN 0;
  864.        END;
  865.     END dx;
  866.  
  867. PROCEDURE dy(y:CARDINAL):CARDINAL;
  868.   BEGIN
  869.     IF INTEGER(y) > 0
  870.        THEN RETURN y * 2;
  871.        ELSE RETURN 0;
  872.        END;
  873.     END dy;
  874.  
  875. PROCEDURE Max(a,b:INTEGER):INTEGER;
  876. BEGIN
  877.   IF a<b
  878.      THEN RETURN b;
  879.      ELSE RETURN a;
  880.      END;
  881.   END Max;
  882.  
  883. PROCEDURE Min(a,b:INTEGER):INTEGER;
  884. BEGIN
  885.   IF b<a
  886.      THEN RETURN b;
  887.      ELSE RETURN a;
  888.      END;
  889.   END Min;
  890.  
  891.  
  892. BEGIN
  893.   RememberKey  := NULL;
  894.   WorkingTitle := " Building new board.  Please wait...";
  895.   PlayTitle    := " Tiles!      Version 2.1";
  896.   noTitle      := "";
  897.   END TilesPlay.
  898.  
  899.  
  900.